perm filename EXPAND.F4[PIC,LCS] blob sn#637515 filedate 1982-01-24 generic text, type T, neo UTF8
00100	C  EXPAND.F4
00200	      INTEGER TOTL,TOTOUT
00300	      COMMON /XYZ/X(650),Y(650),Z(650)
00400	      COMMON /OUTL/OX(650),OY(650),OZ(650)
00500	      COMMON /S/SL(650),P(650)
00600		COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
00700	C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
00800	C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
00900	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
01000		COMMON/I/ I(3000)
01100	1	CALL DPYSET(1,I,3000)
01200		TOTL=0
01300		DDY=0
01400		DDX=0
01500		TOTOUT=0
01600	      CALL READRW
01700	C READ IN THE DRAWING
01800		IB=1
01900		DDX=100
02000		CALL DPY(X,Y,Z,TOTL)
02100	2     CALL RDOUTL
02200	C READ IN THE OUTLINE
02300		IB=1
02400		IF(DDY.NE.0)GO TO 6
02500	C JUMP IF DOING DRAWING TRANSITION.
02600		CALL DPY(OX,OY,OZ,TOTOUT)
02700	3     CALL MAKNEW
02800	C EXPAND THE DRAWING
02900	7	IB=6
03000	C MAKE EXPANDED IMAGE BRIGHTER (IB=6)
03100	4	CALL DPY(X,Y,Z,TOTL)
03200	5     CALL SAVIT
03300	      GO TO 1
03400	6	CALL TRNSIT
03500		GO TO 7
03600	      END
03700	
03800		SUBROUTINE MAKNEW
03900	      INTEGER TOTL,TOTOUT,HIT
04000	      COMMON /XYZ/X(650),Y(650),Z(650)
04100	      COMMON /OUTL/OX(650),OY(650),OZ(650)
04200	      COMMON /S/SL(650),P(650)
04300		COMMON /CCC/G
04400	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
04500	10	FORMAT(' CX=',F6.3,' CY=',F6.3)
04600	11	FORMAT(' X,Y,Z = '2F8.3,F3.0)
04700		TYPE 10,CX,CY
04800	CC	DO 12 K=1,TOTL
04900	CC12	TYPE 11,X(K),Y(K),Z(K)
05000		K=1
05100	1	DO 2 J=2,TOTOUT
05200		IF(HIT(J,OX,OY,K,A,B).LT.0)GO TO 2
05300	C NOW RESET COORDS.
05400		X(K)=CX+(A-CX)*P(K)*G
05500	 	Y(K)=CY+(B-CY)*P(K)*G
05600	CX	X(K)=X(K)+(A-X(K))*G*P(K)
05700	C	Y(K)=Y(K)+(B-Y(K))*G*P(K)
05800	C P = % OF LONGEST LINE FROM CENTER TO A POINT.
05900	CC13	TYPE 11,X(K),Y(K),Z(K)
06000		IF(K.EQ.TOTL)RETURN
06100		K=K+1
06200		GO TO 1
06300	2	CONTINUE
06400		END
06500	
06600		INTEGER FUNCTION HIT(J,OX,OY,K,A,B)
06700		DIMENSION OX(1),OY(1)
06800	      INTEGER TOTL,TOTOUT,HIT
06900	      COMMON /XYZ/X(650),Y(650),Z(650)
07000	CC    COMMON /OUTL/OX(650),OY(650)
07100	      COMMON /S/SL(650),P(650)
07200	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT
07300		RX=OX(J-1)
07400		SX=OX(J)
07500		RY=OY(J-1)
07600		SY=OY(J)
07700		IF(RX.LE.SX)GO TO 2
07800		SX=RX
07900		RX=OX(J)
08000		SY=RY
08100		RY=OY(J)
08200	2	TY=RY
08300		UY=SY
08400		IF(TY.LE.UY)GO TO 4
08500		UY=RY
08600		TY=SY
08700	C TY=BOTTOM, UY =TOP, RX=LEFT, SX=RIGHT
08800	4	C=SX-RX
08900		IF(C.EQ.0)GO TO 1
09000		SS=(SY-RY)/C
09100	C SLOPE OF THIS LINE
09200		A=(RY-CY-SS*RX+SL(K)*CX)/(SL(K)-SS)
09300		B=SS*(A-RX)+RY
09400	5	HIT=-1
09500	C A MISS
09600		IF(A.LT.RX.OR.A.GT.SX)RETURN
09700		IF(B.LT.TY.OR.B.GT.UY)RETURN
09800		IF(Y(K).LT.CY.AND.CY.LT.B)RETURN
09900		IF(Y(K).GT.CY.AND.CY.GT.B)RETURN
10000		IF(X(K).LT.CX.AND.CX.LT.A)RETURN
10100		IF(X(K).GT.CX.AND.CX.GT.A)RETURN
10200		HIT=0
10300	C A HIT 
10400		RETURN
10500	1	B=SL(K)*(SX-CX)+CY
10600		A=RX
10700		GO TO 5
10800		END
10900	
11000		SUBROUTINE DPY(X,Y,Z,L)
11100	      INTEGER TOTL,TOTOUT
11200		DIMENSION X(1),Y(1),Z(1)
11300	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
11400		COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
11500	C MAKE EXPANDED IMAGE BRIGHTER
11600		CALL DPYBRT(IB)
11700		Q=0
11800		IF(IB.GT.4)Q=500
11900	10	DO 1 K=1,L
12000		M=DSZ*X(K)+.5-DDX
12100		N=DSZ*Y(K)+.5-Q
12200		IF(Z(K).NE.0)GO TO 2
12300		CALL AVECT(M,N)
12400		GO TO 1
12500	2	CALL AIVECT(M,N)
12600	1	CONTINUE
12700		CALL DPYOUT(1)
12800		END
12900	
13000		SUBROUTINE SAVIT
13100		INTEGER TOTL
13200	      COMMON /XYZ/X(650),Y(650),Z(650)
13300	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
13400		COMMON/NM2/NM2
13500		CALL IO(3)
13600		IF(NM2.EQ.' ')RETURN
13700		DO 1 K=1,TOTL
13800		A=X(K)
13900		B=.5
14000		IF(A.LT.0)B=-B
14100		L=A+B
14200		A=Y(K)
14300		B=.5
14400		IF(A.LT.0)B=-B
14500		M=A+B
14600		N=Z(K)
14700	1	WRITE(20,2)K,L,M,N
14800		END FILE 20
14900	2	FORMAT(1I4,2I5,1I3)
15000		END
15100	
15200		SUBROUTINE TRNSIT
15300	      INTEGER TOTL,TOTOUT
15400		COMMON /XYZ/X(650),Y(650),Z(650)
15500		COMMON /OUTL/OX(650),OY(650),OZ(650)
15600	      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
15700		COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
15800		DDX=600
15900		CALL DPY(OX,OY,OZ,TOTOUT)
16000		DO 1 K=1,TOTL
16100		X(K)=X(K)-(X(K)-OX(K))*CCX
16200	1	Y(K)=Y(K)-(Y(K)-OY(K))*CCY
16300		DDX=350
16400		END